home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 January / PSL Monthly Shareware CD-ROM (Public Software Library) (January 1994).iso / games / dos / cards / blkjack.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-07-21  |  8.0 KB  |  285 lines
  1. 1000  '
  2. 1010  '  ** CCII BLACKJACK - JAN 3,78 - JESSEN **
  3. 1020  ' ADAPTED TO PC BY PATRICK LEABO--TUSCON
  4. 1030  '
  5. 1040  DEF FNUPS$(X$)=CHR$(ASC(X$)+32*(ASC(X$)>96 AND ASC(X$)<123))
  6. 1050  RANDOMIZE VAL(RIGHT$(TIME$,2))*VAL(MID$(TIME$,4,2))
  7. 1060  Z7=RND: A=1: CLS
  8. 1070  COLOR 1: LOCATE 1,1: PRINT"KEY"STRING$(51,"THEN")"<0xCB!>"STRING$(26,"THEN")"CLOSE";
  9. 1080  FOR N=2 TO 24: LOCATE N,1: PRINT"OPEN";
  10. 1090  LOCATE N,53: PRINT "OPEN";: LOCATE N,80: PRINT "OPEN";: NEXT
  11. 1100  LOCATE 25,1:PRINT"SCREEN"STRING$(51,"THEN")"LOCATE"STRING$(26,"THEN");
  12. 1110  LOCATE 19,53:PRINT"TOTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENRANDOMIZE"
  13. 1120  DEF SEG=&HB800: POKE 3999,1: POKE 3998,188
  14. 1130  '
  15. 1140  COLOR 14: LOCATE 2,59: PRINT "IBM PC BLACKJACK";
  16. 1150  LOCATE 3,61: PRINT"************"
  17. 1160  LOCATE 8,56: PRINT "<return> = stand";
  18. 1170  LOCATE 9,63: PRINT "H = hit";
  19. 1180  LOCATE 10,63: PRINT "D = double down";
  20. 1190  LOCATE 11,63: PRINT "S = split pair";
  21. 1200  LOCATE 13,63: PRINT "RULES:";
  22. 1210  LOCATE 15,55: PRINT "House limit is $500.00";
  23. 1220  LOCATE 16,55: PRINT "Blackjack pays 1RENUM to 1";
  24. 1230  LOCATE 17,55: PRINT "Bet 'E' to quit.";
  25. 1240  FOR YP=1 TO YP+5: LOCATE YP+1,2: PRINT MID$("HOUSE",YP,1);: NEXT
  26. 1250  FOR YP=1 TO YP+6: LOCATE YP+9,2: PRINT MID$("PLAYER",YP,1);: NEXT
  27. 1260  '
  28. 1270  LOCATE 7,7: COLOR 7: PRINT "Welcome to BLACKJACK!"
  29. 1280  K=0: W1=0: R=RND: N=INT(1945*RND+1): X=INT(10*RND)
  30. 1290  DIM A%[22],D[52],E[5],V[5],T[5],W[5],T$[34],Q[52]
  31. 1300  FOR I=0 TO 21: READ A%[I]: NEXT
  32. 1310  DATA &H8B55, &HB8EC, &H0600, &H0AB7, &H768B, &H8A0C, &H8B2C
  33. 1320  DATA &HA76, &HC8A, &H768B, &H8A08, &H8B34, &H676, &H148A
  34. 1330  DATA &HCDFE, &HC9FE, &HCEFE, &HCAFE, &H10CD, &HCA5D, &H8, &H0
  35. 1340  FOR A=1 TO 52: D[A]=0: NEXT
  36. 1350  FOR A=0 TO 39 STEP 13: FOR C=1 TO 13: Q[A+C]=C: NEXT: NEXT
  37. 1360  K=K+1: FOR P=1 TO 5: E[P]=0: V[P]=0: T[P]=0: NEXT: V[3]=1
  38. 1370  R1%=2: C1%=3: R2%=24: C2%=52
  39. 1380  DEF SEG: SUBRT%=VARPTR(A%[0]): CALL SUBRT%(R1%,C1%,R2%,C2%)
  40. 1390  LOCATE 23,54: PRINT SPC(26)
  41. 1400  LOCATE 21,55: COLOR 12
  42. 1410  IF W1=0 THEN PRINT "You're even."SPC(10);: GOTO 1440
  43. 1420  IF W1>0 THEN PRINT "You're ahead $"MID$(STR$(W1),2);SPC(5);: GOTO 1440
  44. 1430  IF W1<0 THEN PRINT "You're behind $"MID$(STR$(W1),2);SPC(5);
  45. 1440  GOSUB 3760: LOCATE 22,55: COLOR 13: PRINT"WAGER ";
  46. 1450  COLOR 10: PRINT "$"SPC(6): P=1
  47. 1460  COLOR 10: W$="": LOCATE 22,62,1
  48. 1470  Q$=INPUT$(1): L=LEN(W$): I=INSTR(W$,"."): IF Q$<>CHR$(27) THEN 1490
  49. 1480  LOCATE ,62,0: PRINT SPC(L);: LOCATE ,62,1: W$="": GOTO 1470
  50. 1490  IF Q$<>CHR$(8) THEN 1520 ELSE IF L=0 THEN 1470
  51. 1500  IF W$="end" THEN 1480
  52. 1510  PRINT CHR$(29)" "CHR$(29);: W$=LEFT$(W$,LEN(W$)-1): GOTO 1470
  53. 1520  IF Q$=CHR$(13) THEN 1570 ELSE IF W$="end" THEN 1470
  54. 1530  IF FNUPS$(Q$)="E" THEN IF L THEN 1470 ELSE 3900: PRINT W$;: GOTO 1470
  55. 1540  IF I=0 AND L=3 AND Q$<>"." OR I AND L-I=2 THEN 1470
  56. 1550  IF Q$="." AND I OR INSTR("0123456789.",Q$)=0 THEN 1470
  57. 1560  PRINT Q$;: W$=W$+Q$: GOTO 1470
  58. 1570  LOCATE ,62,0: PRINT USING "###.##";VAL(W$)
  59. 1580  '
  60. 1590  IF W$="end" THEN COLOR 10: CLS: END
  61. 1600  W=VAL(W$): LOCATE 1,1
  62. 1610  IF W<=500 THEN 1630
  63. 1620  LOCATE 23,55: PRINT "House limit is $500.";: GOSUB 3740: GOTO 1390
  64. 1630  IF W>0 THEN 1650
  65. 1640  LOCATE 23,58: PRINT "Be serious!";: GOSUB 3630: GOTO 1390
  66. 1650  IF W<1 THEN 1680
  67. 1660  HP=HP+1
  68. 1670  GOTO 1710
  69. 1680  LOCATE 23,58
  70. 1690  PRINT "Cheapskate!";
  71. 1700  GOSUB 3740: GOTO 1390
  72. 1710  Q3=W
  73. 1720  IF Q3<250 THEN 1740
  74. 1730  Q3=INT(Q3/10)
  75. 1740  FOR A4=1 TO Q3: X=RND: NEXT: W[2]=W: W[3]=W: GOTO 1770
  76. 1750  TE=0: NT=0: LOCATE 9,14: PRINT "*I am reshuffling*": GOSUB 3630: GOTO 1370
  77. 1760  LOCATE 9,2: PRINT "House limit is $500.": GOSUB 3740: GOTO 1390
  78. 1770  E[5]=1: GOSUB 3660: GOSUB 2510: IF E[1]=0 THEN 1790
  79. 1780  V[4]=1
  80. 1790  V[5]=1: E[5]=2: GOSUB 3660: GOSUB 2510: M=X: P=3: V[3]=1
  81. 1800  GOSUB 3660: GOSUB 2510: G=X
  82. 1810  GOSUB 3780
  83. 1820  V[3]=V[3]+1
  84. 1830  GOSUB 3660: GOSUB 2510: IF V[2]>0 THEN 2060
  85. 1840  S=X
  86. 1850  IF V[3]>2 THEN 2060
  87. 1860  IF T[P]<21 THEN 1960
  88. 1870  IF E[P]<2 THEN 1890
  89. 1880  E[P]=E[P]-1: T[P]=T[P]-10: GOTO 1960
  90. 1890  LOCATE Y9+2,X9+8: PRINT "*BLACKJACK*"
  91. 1900  LOCATE 9,10: PRINT "I dealt wrong again!"
  92. 1910  E[5]=2: P=1: X9=8: Y9=3: X=M: GOSUB 2730
  93. 1920  IF V[3]<5 THEN 1940
  94. 1930  W1=W1+2*W: GOTO 1950
  95. 1940  W1=W1+1.5*W
  96. 1950  GOTO 3440
  97. 1960  IF V[4]= 0 THEN 2060
  98. 1970  LOCATE 9,15: PRINT SPC(22)
  99. 1980  LOCATE 9,15: GOSUB 3760: PRINT "INSURANCE ";: COLOR 31,0: PRINT "?";
  100. 1990  KS$=FNUPS$(INPUT$(1)): COLOR 7,0: LOCATE 9,15: PRINT SPC(11);
  101. 2000  IF KS$<>"Y" THEN 2060
  102. 2010  IF T[1]<21 THEN 2040
  103. 2020  W1=W1+W: PRINT
  104. 2030  LOCATE 9,8: PRINT "You won $"MID$(STR$(W/2),2)" on insurance.": GOTO 2060
  105. 2040  W1=W1-W/2: PRINT
  106. 2050  LOCATE 9,8: PRINT "You lost $"MID$(STR$(W/2),2)" on insurance."
  107. 2060  IF T[1]<21 THEN 2110
  108. 2070  IF E[1]<2 THEN 2090
  109. 2080  E[1]=E[1]-1: T[1]=T[1]-10: GOTO 2110
  110. 2090  LOCATE 9,22: PRINT "**I HAVE BLACKJACK**"
  111. 2100  X9=8: Y9=3: E[5]=2: P=1: X=M: GOSUB 2730: P=3: GOTO 3350
  112. 2110  IF T[P]<=21 THEN 2170
  113. 2120  IF E[P]>0 THEN 2160
  114. 2130  LOCATE 9,16: PRINT "**YOU BUST**"
  115. 2140  GOSUB 3710: C1=T[P]-5*(INT(T[P]/5)): IF V[2]=1 THEN 2390
  116. 2150  GOTO 3120
  117. 2160  E[P]=E[P]-1: T[P]=T[P]-10
  118. 2170  IF V[1]=2 THEN 2140
  119. 2180  IF V[3]>4 THEN 2200
  120. 2190  GOTO 2210
  121. 2200  IF T[P]<21 THEN 3640
  122. 2210  LOCATE Y9+2,X9+8: GOSUB 3760: COLOR 31,0: PRINT "PLAY ";: COLOR 7,0
  123. 2220  V[1]=0
  124. 2230  KS$=FNUPS$(INPUT$(1)): IF KS$="H" THEN V[1]=1: GOTO 2270
  125. 2240  IF KS$="D" THEN V[1]=2: GOTO 2270
  126. 2250  IF KS$="S" THEN V[1]=3: GOTO 2270
  127. 2260  IF KS$<>CHR$(13) THEN BEEP: GOTO 2230
  128. 2270  LOCATE Y9+2,X9+8: PRINT SPC(5)
  129. 2280  IF V[1]<3 THEN 2440
  130. 2290  IF V[2]>0 THEN 2420
  131. 2300  IF V[3]>2 THEN 2420
  132. 2310  IF Q[G]=Q[S] THEN 2340
  133. 2320  LOCATE 9,22: PRINT "That's no pair!": GOSUB 3740
  134. 2330  LOCATE 9,22: PRINT SPC(15);: GOTO 2210
  135. 2340  V[2]=1: IF Q[G]<1 THEN 2360
  136. 2350  V[1]=0
  137. 2360  T[3]=0: T[2]=0: P=2: X9=2: Y9=19'   : GOSUB 3550
  138. 2370  X=S: GOSUB 2730: GOSUB 2380: P=3: W[3]=W: X=G: GOSUB 2380: GOTO 1830
  139. 2380  GOSUB 2660: V[3]=2: T[P]=C: RETURN
  140. 2390  P=2: V[2]=2: V[3]=2: IF Q[G]<1 THEN 2410
  141. 2400  V[1]=0
  142. 2410  GOTO 1830
  143. 2420  LOCATE 9,22: PRINT "No splits now.": GOSUB 3740
  144. 2430  LOCATE 9,22: PRINT SPC(14);: GOTO 2210
  145. 2440  IF V[1]<2 THEN 2490
  146. 2450  IF V[3]=2 THEN 2480
  147. 2460  LOCATE 9,22: PRINT "It's too late to double": GOSUB 3740
  148. 2470  LOCATE 9,22: PRINT SPC(23);: GOTO 2210
  149. 2480  W[P]=2*W[P]
  150. 2490  IF V[1]>0 THEN 1820
  151. 2500  GOTO 2140
  152. 2510  GOSUB 2540: T[P]=T[P]+C: IF V[5]=0 THEN 2530
  153. 2520  V[5]=0: RETURN
  154. 2530  GOSUB 2730: RETURN
  155. 2540  IF R>=50 THEN 2590
  156. 2550  X=INT(53*RND)
  157. 2560  IF X=0 THEN 2550
  158. 2570  IF D[X]=0 THEN 2640
  159. 2580  R=R+1: IF R<50 THEN 2540
  160. 2590  FOR A=1 TO 52: IF D[A]=K THEN 2610
  161. 2600  D[A]=0
  162. 2610  NEXT 
  163. 2620  TE=0: NT=0: R=0: LOCATE 9,18: PRINT "*I RESHUFFLED*": GOSUB 3740
  164. 2630  LOCATE 9,18: PRINT"                 ": GOTO 2540
  165. 2640  R=0
  166. 2650  D[X]=K
  167. 2660  IF Q[X]>1 THEN 2680
  168. 2670  C=11: E[P]=E[P]+1: RETURN
  169. 2680  IF Q[X]>10 THEN 2700
  170. 2690  C=Q[X]: RETURN
  171. 2700  C=10: RETURN
  172. 2710  '
  173. 2720  '
  174. 2730  FOR I=0 TO 34: T$[I]=" ": NEXT
  175. 2740  IF X>39 THEN U$=CHR$(5): COLOR 0,7: GOTO 2780
  176. 2750  IF X>26 THEN U$=CHR$(3): COLOR 4,7: GOTO 2780
  177. 2760  IF X>13 THEN U$=CHR$(4): COLOR 4,7: GOTO 2780
  178. 2770               U$=CHR$(6): COLOR 0,7
  179. 2780  ON Q[X] GOTO 2970,2960,2950,2940,2920,2900,2890,2880,2870,2850,2810,2800
  180. 2790  T$[17]="K": GOTO 2820
  181. 2800  T$[17]="Q": GOTO 2820
  182. 2810  T$[17]="J"
  183. 2820  T$[8]=U$: T$[7]=U$: T$[6]=U$: T$[11]=U$: T$[16]=U$
  184. 2830  T$[21]=U$: T$[26]=U$: T$[27]=U$: T$[28]=U$: T$[23]=U$
  185. 2840  T$[18]=U$: T$[13]=U$: GOTO 2980
  186. 2850  T$[6]=U$: T$[8]=U$: T$[16]=U$: T$[18]=U$: T$[26]=U$
  187. 2860  T$[28]=U$: GOTO 2940
  188. 2870  T$[7]=U$: T$[27]=U$: GOTO 2890
  189. 2880  T$[12]=U$: T$[22]=U$: GOTO 2900
  190. 2890  T$[17]=U$
  191. 2900  T$[6]=U$: T$[8]=U$: T$[16]=U$: T$[18]=U$: T$[26]=U$
  192. 2910  T$[28]=U$: GOTO 2980
  193. 2920  T$[6]=U$: T$[8]=U$: T$[17]=U$: T$[26]=U$: T$[28]=U$
  194. 2930  GOTO 2980
  195. 2940  T$[11]=U$: T$[13]=U$: T$[21]=U$: T$[23]=U$: GOTO 2980
  196. 2950  T$[7]=U$: T$[17]=U$: T$[27]=U$: GOTO 2980
  197. 2960  T$[12]=U$: T$[22]=U$: GOTO 2980
  198. 2970  T$[17]=U$
  199. 2980  IF Q[X]>1 AND Q[X]<11 THEN T$=RIGHT$(STR$(Q[X]),1)
  200. 2990  IF Q[X]=11 THEN T$="J"
  201. 3000  IF Q[X]=12 THEN T$="Q"
  202. 3010  IF Q[X]=13 THEN T$="K"
  203. 3020  IF Q[X]= 1 THEN T$="A"
  204. 3030  IF Q[X]<>10 THEN 3060
  205. 3040  T$=LEFT$(U$,1): M$="0": N$="1"
  206. 3050  T$[0]=N$: T$[1]=M$: T$[33]=T$[0]: T$[34]=T$[1]: GOTO 3070
  207. 3060  T$[0]=T$: T$[34]=T$
  208. 3070  Z9=Y9+5: X1=X9: Y1=Y9
  209. 3080  NT=NT+1: IF Q[X]>9 THEN TE=TE+1
  210. 3090  FOR I=0 TO 30 STEP 5: LOCATE Z9-I/5,X9+2: FOR J=0 TO 4: PRINT T$[I+J];
  211. 3100  NEXT: NEXT: COLOR 7,0: RETURN
  212. 3110  '
  213. 3120  P=3: X=M: X9=8: Y9=3: GOSUB 2730
  214. 3130  IF T[3]<22 THEN 3160
  215. 3140  IF V[2]=0 THEN 3350
  216. 3150  GOTO 3350
  217. 3160  P=1
  218. 3170  IF T[1]<17 THEN 3460
  219. 3180  IF T[1]>17 THEN 3200
  220. 3190  IF E[1]> 0 THEN 3460
  221. 3200  IF T[1]>21 THEN 3470
  222. 3210  P=3
  223. 3220  LOCATE 5,X9+7: PRINT "TOTAL": LOCATE 7,X9+7:PRINT T[1];
  224. 3230  IF T[P]>21 THEN 3270
  225. 3240  IF T[1]>21 THEN 3270
  226. 3250  IF T[1]>T[P] THEN 3350
  227. 3260  IF T[1]=T[P] THEN 3420
  228. 3270  W1=W1+W[P]: PRINT: LOCATE 9,2
  229. 3280  PRINT SPC(50): LOCATE 9,12
  230. 3290  IF C1>3 THEN 3520
  231. 3300  IF C1>2 THEN 3530
  232. 3310  IF C1>1 THEN 3540
  233. 3320  IF C1>0 THEN 3550
  234. 3330  GOTO 3560
  235. 3340  '
  236. 3350  W1=W1-W[P]: PRINT: LOCATE 9,2
  237. 3360  PRINT SPC(50): LOCATE 9,12
  238. 3370  IF C1>3 THEN 3570
  239. 3380  IF C1>2 THEN 3580
  240. 3390  IF C1>1 THEN 3590
  241. 3400  IF C1>0 THEN 3600
  242. 3410  GOTO 3610
  243. 3420  LOCATE 9,24: PRINT "WE PUSH"
  244. 3430  IF V[2]>0 THEN 3450
  245. 3440  GOSUB 3500: GOSUB 3740: GOTO 1360
  246. 3450  P=3: V[2]=0: GOTO 3230
  247. 3460  E[5]=E[5]+1: P=1: GOSUB 3660: GOSUB 2510: GOTO 3160
  248. 3470  IF E[1]=0 THEN 3490
  249. 3480  E[1]=E[1]-1: T[1]=T[1]-10: GOTO 3160
  250. 3490  LOCATE 6,X9+13: PRINT "*I BUST*": GOTO 3210
  251. 3500  LOCATE 9,25: RETURN
  252. 3510  '
  253. 3520  PRINT "I must have dealt wrong.": GOTO 3430
  254. 3530  PRINT "You're lucky again.": GOTO 3430
  255. 3540  PRINT "You must have been peeking.": GOTO 3430
  256. 3550  PRINT "I could lose my job this way!": GOTO 3430
  257. 3560  PRINT "The cards have turned against me.": GOTO 3430
  258. 3570  PRINT "*The bottom of the deck strikes again*": GOTO 3430
  259. 3580  PRINT "a victory for us good guys": GOTO 3430
  260. 3590  PRINT "You can't beat skill.": GOTO 3430
  261. 3600  PRINT "You can't win them all.": GOTO 3430
  262. 3610  PRINT "Thanks!": GOTO 3430
  263. 3620  '
  264. 3630  FOR M9=1 TO 52: D[M9]=0: NEXT: R=0: RETURN
  265. 3640  LOCATE 9,12: PRINT "*You win with 5 cards*": PRINT: GOTO 1910
  266. 3650  '
  267. 3660  ON P GOTO 3670,3680,3690
  268. 3670  X9=INT(2+E[5]*6-6): Y9=3: RETURN
  269. 3680  X9=INT(2+V[3]*6-6): Y9=19: RETURN
  270. 3690  X9=INT(2+V[3]*6-6): Y9=11: RETURN
  271. 3700  '
  272. 3710  LOCATE Y9,X9+7: PRINT "TOTAL";
  273. 3720  LOCATE Y9+3,X9+7: PRINT T[P];: RETURN
  274. 3730  '
  275. 3740  FOR P1=1 TO 1500: NEXT: RETURN ' PAUSE
  276. 3750  PLAY "L64T200N46": RETURN ' PLINK
  277. 3760  PLAY "L64T200N70": RETURN ' PLONK
  278. 3770  '
  279. 3780  '  BACK OF CARD
  280. 3790  '
  281. 3800  COLOR 0,7: CB$= "NNNNN": GOSUB 3750
  282. 3810  X1=10: Y1=1: FOR NN=7 TO 1 STEP - 1
  283. 3820  LOCATE Y1+NN,X1: PRINT CB$: NEXT: COLOR 7,0: RETURN
  284. 3900  CLS:SYSTEM
  285.